home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / XSOURCE / XSOURCE.ZIP / vfpsource / wizards / Wzquery / wzquery.prg < prev    next >
Encoding:
Text File  |  1998-05-01  |  9.1 KB  |  390 lines
  1. #include wzquery.h
  2.  
  3. * This is the stub which you should copy (place the modified version in
  4. * your Wizard's directory), rename, and modify to call your wizard.
  5.  
  6. parameters cOutFileVarName, p2, p3, p4, p5, p6, p7, p8, p9
  7.  
  8. *- p2:    'R'        remote query
  9. *-        'V'        local view
  10. *-        'Q'        query
  11.  
  12. LOCAL cWizardToRun
  13. cWizardToRun = ""
  14.  
  15. private cClassLib
  16. m.cClassLib = set('classlib')
  17.  
  18. * Modify here to reference your wizard's .vcx.
  19. set classlib to wzquery
  20.  
  21. public oWizard
  22.  
  23. PUBLIC wzaQDD[1,6]
  24. PUBLIC wzaQFlds[1]
  25. PUBLIC wzaQSort[1]
  26. PUBLIC wziQSortA    &&1 for ASCEND, 2 for desc
  27. if .f.
  28.     public achoices[1]
  29. endif
  30. wziQsortA=1
  31. PUBLIC wzaQFilt[1,6]
  32. PUBLIC wzaQGrp[1,2]
  33. PUBLIC wzaParent,wzaChild
  34. PUBLIC cOriginalDBC
  35. wzaQDD=""
  36. wzaQFlds=""
  37. wzaQSort=""
  38. wzaQFilt=""
  39. wzaQGrp=""
  40. PUBLIC QWizType    && Remote,Local,Query
  41. QWizType=IIF(type("p2")='L','Q',UPPER(LEFT(p2,1)))    &&Remote,Local,Query
  42. IF !m.qWizType$"RVQ"
  43.     RELEASE qWizType
  44.     return .f.
  45. ENDIF
  46.  
  47. *save the current DBC
  48. cOriginalDBC = SET("DATA")
  49.  
  50. * The name "oWizard" is used in automated testing and should *NOT* be changed.
  51.  
  52. oWizard = createobj(IIF(m.qWizType='R','wzrquery','wzbquery'), m.cOutFileVarName, m.p2, m.p3, m.p4, ;
  53.     m.p5, m.p6, m.p7, m.p8, m.p9)
  54.  
  55. if type('oWizard') = 'O' .and. .not. isnull(oWizard)
  56.     oEngine.aEnvironment[17,1] = m.cClassLib
  57.     if type("starttime")#'U'
  58.         *do not localize:
  59.         wait window nowait "time = "+str(seconds()-starttime,10,4)
  60.     endif
  61.     if type("fp")#'U'
  62.         =fclose(fp)
  63.     endif
  64.     oWizard.Show
  65. ELSE
  66. endif
  67. if type('oWizard') = 'O' .and. .not. isnull(oWizard)
  68.     * It must be modeless, so leave it alone
  69. else
  70.     release oWizard
  71.     RELEASE wzaQDD,wzaQFlds,wzaQSort,wzaQGrp,wzaQFilt,wzaParent,wzaChild,wziQSorta, cOriginalDBC
  72.     cWizardToRun = IIF(IIF(type("p2")='L','Q',UPPER(LEFT(p2,1))) = 'R','wzrquery','wzbquery')
  73.     CLEAR CLASS &cWizardToRun
  74.     CLEAR CLASS wiztemplate
  75. endif
  76.  
  77. return
  78.  
  79.  
  80. *******************************************
  81. #define MAXPATH 50
  82.  
  83. DEFINE CLASS wzQueryEng as WizEngineAll
  84.     mdev=iif(file("\calvinh.txt") AND left(getenv("computername"),6)="CALVIN",.t.,.f.)
  85.     mSaveDeleted=Set("deleted")
  86.     mSaveExact=Set("exact")
  87.     mSaveTrbe=set("trbetween")    
  88.     
  89.     cServer=""
  90.  
  91.     cWzDBC=""
  92.     cConnect=""
  93.     cDriver=""
  94.     nConnectHandle=0
  95.     cOuterJoin=0
  96.     cWizFiltExpr=""    && filled in by SearchClass
  97.     lIsPreview=.f.
  98.     nSaveOptions=1
  99.     wzsFilename=""
  100.     wzsViewname=""
  101.     
  102.     nJoinOption = 1    && inner join (1), left outer (2), right outer (3), full (4)
  103.     nAmount = -1    && all records (-1) n records (n)
  104.     nPortion = 1    && percentage (1), number (2)
  105.     lOdbcJoin = .T.    && Odbc join escape sequence
  106.     UserInput = ""
  107.     UserName = ""    &&user name return by the connection to Oracle server    
  108.  
  109. *Filter page:
  110.     cValue="c:\fox30\samples\data\nwind.dbc"
  111.     
  112.     DIMENSION aODBCDSNs[1,2]
  113.     aODBCDSNs = ""
  114.     
  115.     proc error
  116.         para nError,cMethod,nLine
  117.         IF nError=1523
  118.             RETURN
  119.         ENDIF
  120.         IF UPPER(m.cMethod)='PREVIEWQ'
  121.             m.error=m.nError
  122.             RETURN
  123.         ENDIF
  124.         IF UPPER(m.cMethod)='PROCESSOUTPUT'
  125.             m.error=m.nError
  126.             RETURN
  127.         ENDIF
  128.         wizengineall::error(m.nError,m.cMethod,m.nLine)
  129.     proc init2
  130.         set safe off
  131.         set dele on
  132.         set exact off
  133.         if m.qwiztype='Q'
  134.             set exclusive off
  135.         ELSE
  136.             set exclusive on
  137.         endif
  138.         if this.mdev
  139.             on key label f2 do showdd
  140.             set esca on
  141.             set trbetween off
  142.         endif
  143.     endproc
  144.     proc destroy
  145.         wizengineall::destroy()
  146.         if this.mdev
  147.             on key label f2
  148.         endif
  149.         if this.nConnectHandle>0
  150.             =SQLDisconnect(this.nConnectHandle)
  151.         endif
  152.         local mt
  153.         mt=this.mSaveDeleted
  154.         set dele &mt
  155.         mt=this.mSaveExact
  156.         set exact &mt
  157.         if this.msavetrbe="ON"
  158.             set trbe on
  159.         endif
  160.         RELEASE wzaQDD,qwiztype,wzaQflds,wzaQGrp,wzaQSort,wzaParent,wzachild,wzaQFilt,wziQSorta,aWizFList, cOriginalDBC
  161.     PROCEDURE insaitem
  162.         * Inserts an array element into an array.
  163.         * For 1-D or 2D array
  164.         * returns the row #that was inserted.
  165.         LPARAMETER aArray,sContents,wziRow
  166.         if alen(aArray,2)=0 &&it's a 1-D array
  167.             IF ALEN(aArray) = 1 AND EMPTY(aArray[1])
  168.                 aArray[1]=m.sContents
  169.                 wziRow=1
  170.             ELSE
  171.                 DIMENSION aArray[ALEN(aArray)+1]
  172.                 IF PARAM()=2
  173.                     wziRow=ALEN(aArray)
  174.                     aArray[m.wziRow]=m.sContents
  175.                 ELSE
  176.                     =AINS(aArray,m.wziRow)
  177.                     aArray[m.wziRow]=m.sContents
  178.                 ENDIF    
  179.             ENDIF
  180.         else    &&it's a 2D array
  181.             if ALEN(aArray,1)=1
  182.                 wziRow=1
  183.                 if !empty(aArray[1,1])
  184.                     dime aArray[2,alen(aArray,2)]
  185.                     =ains(aArray,1)
  186.                 endif
  187.             else
  188.                 if type("wziRow")#'N'
  189.                     wziRow=ALEN(aArray,1)
  190.                 endif
  191.                 if m.wziRow>ALEN(aArray,1)
  192.                     wziRow=ALEN(aArray,1)
  193.                 endif
  194.                 dime aArray[ALEN(aArray,1)+1,ALEN(aArray,2)]
  195.                 =ains(aArray,m.wziRow)
  196.             endif
  197.             aArray[m.wziRow,1]=m.sContents
  198.         endif
  199.         return m.wziRow
  200.     ENDPROC
  201.  
  202.     PROCEDURE delaitem
  203.         * Generic routine to delete an array element.
  204.         * works with 1 or 2 D array
  205.         LPARAMETERS aArray,wziRow
  206.         IF ALEN(aArray,1)>=m.wziRow
  207.             IF ALEN(aArray,1)=1
  208.                 aArray=''
  209.             ELSE
  210.                 =ADEL(aArray,m.wziRow)
  211.                 if ALEN(aArray,2)=0
  212.                     DIMENSION aArray[ALEN(aArray)-1]
  213.                 else
  214.                     DIMENSION aArray[ALEN(aArray,1)-1,ALEN(aArray,2)]
  215.                 endif
  216.             ENDIF
  217.         ENDIF
  218.     ENDPROC
  219.     proc thealias
  220.         para m.name
  221.     return LEFTC(m.name,AT_C('.',m.name)-1)
  222.  
  223.     PROCEDURE TheField
  224.         PARAMETERS strng
  225.         PRIVATE m.t
  226.         m.t=SUBSTRC(m.strng,AT_C(".",m.strng)+1)
  227.     RETURN IIF(m.t='(',m.t,ALLTRIM(LEFTC(m.t,LENC(m.t)-3)))
  228.  
  229.     proc ProcessOutput
  230.         PRIVATE m.wzsFileName,m.wzsViewName,m.error
  231.         Local SaveArea
  232.         LOCAL m.lHasNoTask
  233.         
  234.         m.lHasNoTask = IIF(TYPE('THIS.lNoTask')='L',THIS.lNoTask,.F.)
  235.         m.error=0
  236.         SaveArea=select()
  237.         m.wzsFileName=oEngine.wzsFileName
  238.         m.wzsViewName=oEngine.wzsViewName
  239.         m.wzsVersion=".001"
  240.         m.wzsQWiz=IIF(this.nConnectHandle=0,"SQ","CS")
  241.         m.wzlTesting=.t.
  242.         m.wzsFileName=STRTRAN(SYS(2023)+"\PREVIEWQ.tmp","\\","\")
  243.         IF m.qwiztype='Q' AND !this.lIsPreview
  244.             m.wzsFileName=oEngine.wzsFileName
  245.         ENDIF
  246.         IF m.qWizType$"RV" AND DBC()#oWizard.cOrigDBC
  247.             SET DATA TO (oWizard.cOrigDBC)
  248.         ENDIF
  249.  
  250.  
  251.         IF EMPTY(m.wzsFileName)
  252.             RETURN .f.
  253.         ENDIF
  254.  
  255.         SET MESSAGE TO PREVIEW_LOC 
  256.         do emit
  257.         SELECT (m.SaveArea)
  258.         IF !this.lIsPreview
  259.             if oEngine.Mdev
  260.             endif
  261.  
  262.             IF m.qWizType#'Q'
  263.                 Compile (m.wzsFileName)
  264.                 DO (m.wzsFileName)    && create the view
  265.                 if oengine.mdev
  266.                     * set step on
  267.                 endif
  268.                 IF this.nSaveOptions = 1 && save
  269.                     erase (m.wzsFilename)
  270.                     erase (LEFT(m.wzsFileName,RAT('.',m.wzsFilename))+"fxp")
  271.                 ENDIF
  272.                 IF m.error>0
  273.                     oEngine.Alert(message())
  274.                 ENDIF
  275.             ELSE
  276.                 oEngine.cOutFile=m.wzsFileName
  277.             ENDIF
  278.             DO CASE
  279.             CASE this.nSaveOptions=2    &&save & run
  280.                 IF m.qWizType#'Q'
  281.                     USE (m.wzsViewName)
  282.                     owizard.form1.visible=.f.
  283.                     oEngine.AddAliasToPreservedList(ALIAS())
  284.                     ACTI WIND SCREEN
  285.                     BROW NOWAIT normal
  286.                 ELSE
  287.                     _Shell="DO " + '"' + m.wzsFileName + '"'
  288.                 ENDIF
  289.                 oWizard.lRunOnReturn    = .t.
  290.             CASE this.nSaveOptions=3    &&save & Modify
  291.                 DO CASE
  292.                 CASE m.qWizType$"VR"
  293.                     _SHELL="MODIFY VIEW "+'"'+m.wzsViewName+'"'
  294.                     OEngine.aEnvironment[33,1] = DBC()
  295.                 CASE m.qWizType='Q'
  296.                     _SHELL="MODIFY QUERY " + '"'+m.wzsFileName+ '"'
  297.                 ENDCASE
  298.                 oWizard.lModifyOnReturn    = .t.
  299.             ENDCASE
  300.  
  301.             * clean-up
  302.             IF m.qWizType # 'Q'
  303.                 erase (m.wzsFilename)
  304.                 erase (LEFT(m.wzsFileName,RAT('.',m.wzsFilename))+"fxp")
  305.                 IF m.error > 0
  306.                     oEngine.Alert(message())
  307.                 ENDIF
  308.             ENDIF
  309.         ENDIF
  310.  
  311.     *----------------------------------
  312.     PROCEDURE GetODBCDrvrs
  313.     *----------------------------------
  314.         *- get a list of the ODBC data sources
  315.  
  316.         PARAMETER aODBCDrvrs
  317.  
  318.         LOCAL oReg, i
  319.         LOCAL nPos,cSaveExact, retval, cValue
  320.  
  321.         IF !_mac
  322.             *- supported only on Macintosh
  323.             RETURN
  324.         ENDIF
  325.  
  326.          DIMENSION aODBCDrvrs[1,2]
  327.  
  328.          LOCAL aODBCSects, cODBCFile
  329.  
  330.         *- look in ODBC preferences file
  331.         *- There;s an ODBC Preferences, and an ODBC Preferences PPC file
  332.         cODBCFile = IIF(THIS.GetMacCPU() == "PPC", ODBC_FILE_MACPPC, ODBC_FILE_MAC)
  333.  
  334.         DIMENSION aODBCSects[1]            && reset for new file
  335.         aODBCSects = ""
  336.         retval = THIS.GetINISection(@aODBCSects,ODBC_SOURCE,cODBCFile)
  337.         DO CASE
  338.             CASE m.retval = ERROR_NOINIFILE
  339.                 THIS.Alert(E_ODBC1_LOC)
  340.                 LOOP
  341.             CASE m.retval = ERROR_NOINIENTRY
  342.                 * do nothing
  343.             CASE m.retval = ERROR_FAILINI
  344.                 * do nothing
  345.             OTHERWISE
  346.                 FOR i = 1 TO ALEN(aODBCSects)
  347.                     cValue = ""
  348.                     cValue = THIS.GetPref(ODBC_SOURCE,aODBCSects[m.i],cODBCFile)
  349.                     IF ATC(SQLODBC_ANY,cValue) # 0
  350.                         IF !EMPTY(aODBCDrvrs[1])
  351.                             DIMENSION aODBCDrvrs[ALEN(aODBCDrvrs,1)+1,2]
  352.                         ENDIF
  353.                         aODBCDrvrs[ALEN(aODBCDrvrs,1),1] = aODBCSects[m.i]
  354.                         aODBCDrvrs[ALEN(aODBCDrvrs,1),2] = m.cValue            
  355.                     ENDIF
  356.                 ENDFOR
  357.         ENDCASE
  358.  
  359.         RETURN .T.
  360.  
  361.     ENDPROC
  362.     
  363.     PROCEDURE OverWriteOK
  364.         PARAMETERS lcMessageText
  365.         LOCAL aButtonNames
  366.         
  367.         DIMENSION aButtonNames[3]
  368.         aButtonNames[1]=BTN_CREATE_LOC
  369.         aButtonNames[2]=BTN_OPEN_LOC
  370.         aButtonNames[3]=BTN_CANCEL_LOC
  371.         MyMessageBox=CREATEOBJECT('MessageBox2',lcMessageText, @aButtonNames)
  372.         MyMessageBox.show
  373.  
  374.     ENDPROC
  375.  
  376.     PROCEDURE AScanner2
  377.         PARAMETERS aArray,cSearch,nCol
  378.         external array aArray
  379.         LOCAL i
  380.         FOR i=1 TO ALEN(aArray,1)
  381.             IF TYPE("aArray[m.i,1]")='C' AND UPPER(aArray[m.i,1])==UPPER(cSearch)
  382.                 RETURN m.i
  383.             ENDIF
  384.         ENDFOR
  385.     RETURN 0
  386.     
  387. ENDDEFINE
  388.  
  389.  
  390.